perm filename ITMSUB.LST[XX,LCS] blob
sn#207661 filedate 1976-03-25 generic text, type T, neo UTF8
ITMSUB.F4 F40 V25 25-MAR-76 14:57 PAGE 1
00100 C**** ITMSUB, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200 C ********** WHOLE & HALF RESTS, BEAMS ******
00300 SUBROUTINE ITMSUB
1M BLOCK 0
00400 IMPLICIT INTEGER(A-Q,S-Z)
00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600 COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),RE,RF,RG,RH/BM/RA,RC,RJY
00800 COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
01100 COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
01200 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(R11,
01300 1RJQ(9)),(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01400 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01500 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01600 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01700 1,RDBR/ 3.5/,RBR/.33/,RBX/ 7.0/
01800 C RDBR IS SPACER FOR DBL BAR.
01900 C RTF COMPENSATES FOR BAD PLANNING.
02000 RST7=RSTJ2*7.
MOVSI 02,203700
FMPR 02,RSTJ2
MOVEM 02,RST7
02100 RST18=RSTJ2*18.
MOVSI 02,205440
FMPR 02,RSTJ2
MOVEM 02,RST18
02200 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02300
02400 R3Q=R3
ITMSUB.F4 F40 V25 25-MAR-76 14:58 PAGE 2
MOVE 02,R3
MOVEM 02,R3Q
02500 C NEXT DRAWS STRAIGHT LINES
02600
02700 RD=R4*RST7
MOVE 02,RST7
FMPR 02,R4
MOVEM 02,RD
02800 RA=0
SETZM RA
02900 RX=RTF*RSTJ2+POS
MOVE 02,RTF
FMPR 02,RSTJ2
FADR 02,POS
MOVEM 02,RX
03000 C SOMEDAY ADD < RDIS=1./DIS > TO REPLACE ALL 1./DIS'S
03010 J10=J10*DIS*RSTJ2
JSA 16,FLOAT
ARG 00,J10
FMPR 00,DIS
FMPR 00,RSTJ2
MOVEM 00,%TEMP.
JSA 16,IFIX
ARG 00,%TEMP.
MOVEM 00,J10
03020 C THICKNESS DEPENDS ON FINAL SIZE FACTOR (DIS) AND STAFF SIZE.(???!!)
03100 IF(J5.EQ.50)GO TO 300
MOVEI 02,62
CAMN 02,J5
JRST 300P
03200 C 50 IS FOR CRESC., DECRESC. AND BOXES
03300 IF(R6.NE.0)GO TO 401
MOVE 02,R6
JUMPN 02,401P
03400 IF(J7.NE.0)GO TO 401
MOVE 02,J7
JUMPN 02,401P
ITMSUB.F4 F40 V25 25-MAR-76 14:58 PAGE 3
03500 C FOR BAR LINES
03600 4000 JA=44
4000P MOVEI 02,54
MOVEM 02,JA
03700 C CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
03800 C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
03900 DBR=0
SETZM DBR
04000 IF(J4.LT.1000)GO TO 400
MOVEI 02,1750
CAMLE 02,J4
JRST 400P
04100 C J4=1001 = DBL BAR, =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04200 CK J4=J4-1000
04300 CK DBR=-1
04400 CK400 J7=(J4/100)*DIS
04500 DBR=J4/1000
MOVE 02,J4
IDIVI 02,1750
MOVEM 02,DBR
04600 J4=J4-DBR*1000
MOVEI 02,1750
IMUL 02,DBR
SUBM 02,J4
MOVNS 00,J4
04700 C DBR=1 HEAVY BAR IS ON RT. =2 ON LEFT. =3 IN MIDDLE.
04800 9400 RD=RDBR+RDBR*RSTJ2
9400P MOVE 02,RDBR
FMPR 02,RSTJ2
FADR 02,RDBR
MOVEM 02,RD
04900 C TO SPACE THIN BAR FROM HEAVY
05000 IF(J5.EQ.0)GO TO 400
MOVE 02,J5
JUMPE 02,400P
ITMSUB.F4 F40 V25 25-MAR-76 14:59 PAGE 4
05100 C NEXT ADDS REPEAT DOTS TO DBL BAR.
05200 L=J4
MOVE 02,J4
MOVEM 02,L
05300 RJ=L/100
MOVE 02,L
IDIVI 02,144
JSA 16,FLOAT
ARG 00,2
MOVEM 00,RJ
05400 IF(RJ.EQ.0)RJ=6.*RSTJ2
MOVE 02,RJ
JUMPN 02,2M
MOVSI 02,203600
FMPR 02,RSTJ2
MOVEM 02,RJ
2M BLOCK 0
05500 C HEAVY BAR WILL BE 5 LINES WIDE.
05600 RZ=R3
MOVE 02,R3
MOVEM 02,RZ
05700 J4=0
SETZM J4
05800 C MUST BE 0 FOR DOTS IN 'NOTWRT'
05900 IF(DBR.EQ.0)DBR=J5
MOVE 02,DBR
JUMPN 02,3M
MOVE 02,J5
MOVEM 02,DBR
3M BLOCK 0
06000 J5=0
SETZM J5
06100 C J5=1 RPT ↑, =2 RPT ↑, =3 RPT ↑
06200 RJA=RD*2.
MOVE 02,RD
FSC 02,1
MOVEM 02,RJA
ITMSUB.F4 F40 V25 25-MAR-76 14:59 PAGE 5
06300 C TO SPACE DOTS, NOT ACCURATE FOR VERY SMALL OR VERY LARGE SIZE FACTORS
06400 JY=DBR
MOVE 02,DBR
MOVEM 02,JY
06500 IF(DBR.LT.2)GO TO 8400
MOVEI 02,2
CAMLE 02,DBR
JRST 8400P
06600 R3=RJA+RJ+RZ
MOVE 02,RJ
FADR 02,RZ
FADR 02,RJA
MOVEM 02,R3
06700 7400 DO 3400 K=J2,MOD(L,100)+J2-1
7400P MOVNI 02,1
ADD 02,J2
JSA 16,MOD
ARG 00,L
ARG 00,CONST.
ADD 02,0
MOVEM 02,TEMP.
MOVE 15,J2
4M MOVEM 15,K
5M BLOCK 0
06800 RSTJ2=RSTFAC(K)
MOVE 02,RSTFAC+3(15)
MOVEM 02,RSTJ2
06900 POS=STFF(K)
MOVE 02,STFF +3(15)
MOVEM 02,POS
07000 R4=6
MOVSI 02,203600
MOVEM 02,R4
07100 CALL CENTX
JSA 16,CENTX
07200 C SPACES DOTS OUT FROM BAR
07300 CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
MOVE 02,RSTJ2
FADR 02,CENTR
MOVEM 02,%TEMP.
ITMSUB.F4 F40 V25 25-MAR-76 15:00 PAGE 6
JSA 16,RDRAW
ARG 00,CONST.+1
ARG 02,CONST.+2
ARG 02,RDOT
ARG 02,RSTJ2
ARG 02,R3
ARG 02,%TEMP.
ARG 02,RSTJ2
07400 C GO GET THE DOT
07500 R4=8
MOVSI 02,204400
MOVEM 02,R4
07600 CALL CENTX
JSA 16,CENTX
07700 3400 CALL RDRAW(1,17.0,RDOT,RSTJ2,R3,CENTR+RSTJ2,RSTJ2)
3400P MOVE 02,RSTJ2
FADR 02,CENTR
MOVEM 02,%TEMP.
JSA 16,RDRAW
ARG 00,CONST.+1
ARG 02,CONST.+2
ARG 02,RDOT
ARG 02,RSTJ2
ARG 02,R3
ARG 02,%TEMP.
ARG 02,RSTJ2
CAMGE 15,TEMP.
AOJA 15,4M
07800 JY=JY-1
SOS JY
07900 IF(JY.LT.2)GO TO 4400
MOVEI 02,2
CAMLE 02,JY
JRST 4400P
08000 8400 R3=RZ-RJA-4.*RSTJ2
8400P MOVE 02,RZ
FSBR 02,RJA
MOVE 03,RSTJ2
FSC 03,2
FSBR 02,3
MOVEM 02,R3
08100 GO TO 7400
ITMSUB.F4 F40 V25 25-MAR-76 15:00 PAGE 7
JRST 7400P
08200 C DO I NEED ANY MORE RESETS????
08300 4400 J4=L
4400P MOVE 02,L
MOVEM 02,J4
08400 J7=RJ*DIS
MOVE 02,DIS
FMPR 02,RJ
JSA 16,IFIX
ARG 00,2
MOVEM 00,J7
08500 GO TO 5400
JRST 5400P
08600 400 IF(J5.NE.0)GO TO 9400
400P MOVE 02,J5
JUMPN 02,9400P
08700 K=J4/100
MOVE 02,J4
IDIVI 02,144
MOVEM 02,K
08800 C K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
08900 J7=K*DIS
JSA 16,FLOAT
ARG 00,K
FMPR 00,DIS
MOVEM 00,%TEMP.
JSA 16,IFIX
ARG 00,%TEMP.
MOVEM 00,J7
09000 C J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
09100 5400 L=MOD(J4,100)
5400P JSA 16,MOD
ARG 00,J4
ARG 00,CONST.
MOVEM 00,L
09200 IF(L.EQ.0)L=1
MOVE 02,L
JUMPN 02,6M
MOVEI 02,1
ITMSUB.F4 F40 V25 25-MAR-76 15:00 PAGE 8
MOVEM 02,L
6M BLOCK 0
09300 L=L+J2-1
MOVNI 02,1
ADD 02,L
ADD 02,J2
MOVEM 02,L
09400 C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
09500 RA=RTF
MOVE 02,RTF
MOVEM 02,RA
09600 IF(L.LE.4)GO TO 2400
MOVEI 02,4
CAML 02,L
JRST 2400P
09700 L=4
MOVEI 02,4
MOVEM 02,L
09800 RA=300.
MOVSI 02,211454
MOVEM 02,RA
09900 C FOR EXTENDING BARS ABOVE STAFF 4
10000 2400 RY=RSTFAC(L)
2400P MOVE 03,L
MOVE 02,RSTFAC+3(3)
MOVEM 02,RY
10100 RZ=R3Q
MOVE 02,R3Q
MOVEM 02,RZ
10200 C SAVE IT FOR DBL RPT BAR.
10300 RY=STFF(L)+(RA+56.)*RY
MOVSI 02,206700
FADR 02,RA
FMPR 02,RY
MOVE 03,L
FADR 02,STFF +3(3)
MOVEM 02,RY
10400 1400 RA=1
ITMSUB.F4 F40 V25 25-MAR-76 15:00 PAGE 9
1400P MOVSI 02,201400
MOVEM 02,RA
10500 IF(PLT.GE.0)GO TO 140
MOVE 02,PLT
JUMPGE 02,140P
10600 J7=J7+1
AOS J7
10700 RA=1./DIS
MOVSI 02,201400
FDVR 02,DIS
MOVEM 02,RA
10800 C BAR LINES PLOT AS DOUBLE THICKNESS
10900 140 RJX=R3Q
140P MOVE 02,R3Q
MOVEM 02,RJX
11000 42 CALL LINES(R3Q,RX,3)
42P JSA 16,LINES
ARG 02,R3Q
ARG 02,RX
ARG 00,CONST.+3
11100 RJ=-1.
MOVN 02,CONST.+4
MOVEM 02,RJ
11200 RW=RY
MOVE 02,RY
MOVEM 02,RW
11300 406 CALL LINES(RJX,RY,2)
406P JSA 16,LINES
ARG 02,RJX
ARG 02,RY
ARG 00,CONST.+5
11400 IF(J10.EQ.0)GO TO 411
MOVE 02,J10
JUMPE 02,411P
11500 C P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
11600 J7=J10
MOVE 02,J10
MOVEM 02,J7
ITMSUB.F4 F40 V25 25-MAR-76 15:01 PAGE 10
11700 J10=0
SETZM J10
11800 RA=1./DIS
MOVSI 02,201400
FDVR 02,DIS
MOVEM 02,RA
11900 411 IF(J7.GT.0)GO TO 409
411P MOVE 02,J7
JUMPG 02,409P
12000 IF(DBR.LE.0)RETURN
MOVE 02,DBR
JUMPG 02,7M
JRST 8M
7M BLOCK 0
12100 RY=RW
MOVE 02,RW
MOVEM 02,RY
12200 CK R3Q=R3Q-RDBR
12300 RA=RZ-RD
MOVN 02,RD
FADR 02,RZ
MOVEM 02,RA
12400 IF(DBR.NE.1)RA=RJX+RD-1.
MOVEI 02,1
CAMN 02,DBR
JRST 9M
MOVN 02,CONST.+4
FADR 02,RD
FADR 02,RJX
MOVEM 02,RA
9M BLOCK 0
12500 DBR=DBR-2
MOVNI 02,2
ADDM 02,DBR
12600 R3Q=RA
MOVE 02,RA
MOVEM 02,R3Q
12700 GO TO 1400
JRST 1400P
ITMSUB.F4 F40 V25 25-MAR-76 15:01 PAGE 11
12800 CC411 IF(J7.LE.0)RETURN
12900 C FOR 'HEAVY' LINE.
13000 409 RJX=RJX+RA
409P MOVE 02,RA
FADRM 02,RJX
13100 CALL LINES(RJX,RY,2)
JSA 16,LINES
ARG 02,RJX
ARG 02,RY
ARG 00,CONST.+5
13200 J7=J7-1
SOS J7
13300 RY=RW
MOVE 02,RW
MOVEM 02,RY
13400 IF(RJ)RY=RX
MOVE 02,RJ
JUMPGE 02,10M
MOVE 02,RX
MOVEM 02,RY
10M BLOCK 0
13500 RJ=-RJ
MOVNS 00,RJ
13600 GO TO 406
JRST 406P
13700 CC43 IF(RA.LE.0)RETURN
13800 C HOW IS RA.NE.0?
13900 C DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
14000 CC403 RA=RA-3.72
14100 CC R3Q=R3Q+22
14200 CC RJX=RJX+22
14300 C DO ABOVE NEED *RSTJ2? ************
14400 C **** BASED ON '596' ****
ITMSUB.F4 F40 V25 25-MAR-76 15:02 PAGE 12
14500 CC GO TO 42
14600
14700 C FOR CRESC., DECRESC.
14800 300 IF(R7.EQ.0)R7=2.3
300P MOVE 02,R7
JUMPN 02,11M
MOVE 02,CONST.+6
MOVEM 02,R7
11M BLOCK 0
14900 IF(R7.EQ.-1.)R7=-2.3
MOVN 02,CONST.+4
CAME 02,R7
JRST 12M
MOVN 02,CONST.+6
MOVEM 02,R7
12M BLOCK 0
15000 RA=ABS(R7/2.0)*RST7
MOVE 02,R7
FSC 02,777777
MOVEM 02,%TEMP.
JSA 16,ABS
ARG 02,%TEMP.
FMPR 00,RST7
MOVEM 00,RA
15100 C AMOUNT OF SPREAD
15200 RJ=R3Q
MOVE 02,R3Q
MOVEM 02,RJ
15300 RX=RX-RST18+RD
MOVN 02,RST18
FADR 02,RD
FADRM 02,RX
15400 IF(R8.NE.0)GO TO 302
MOVE 02,R8
JUMPN 02,302P
15500 C JUMP TO MAKE BOX
15600 R6=RHORZ(R6)
JSA 16,RHORZ
ITMSUB.F4 F40 V25 25-MAR-76 15:03 PAGE 13
ARG 02,R6
MOVEM 00,R6
15700 IF(R7)GO TO 301
MOVE 02,R7
JUMPL 02,301P
15800 RJ=R6
MOVE 02,R6
MOVEM 02,RJ
15900 R6=R3Q
MOVE 02,R3Q
MOVEM 02,R6
16000 301 CALL LINX(RJ,RX+RA,R6,RX)
301P MOVE 02,RA
FADR 02,RX
MOVEM 02,%TEMP.
JSA 16,LINX
ARG 02,RJ
ARG 02,%TEMP.
ARG 02,R6
ARG 02,RX
16100 CALL LINES(RJ,RX-RA,2)
MOVN 02,RA
FADR 02,RX
MOVEM 02,%TEMP.
JSA 16,LINES
ARG 02,RJ
ARG 02,%TEMP.
ARG 00,CONST.+5
16200 C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
16300 CC IF(PLT.NE.-2)RETURN
16400 IF(PLT.GE.0)RETURN
MOVE 02,PLT
JUMPL 02,13M
JRST 8M
13M BLOCK 0
16500 C THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
16600 IF(J8)RETURN
MOVE 02,J8
JUMPGE 02,14M
JRST 8M
ITMSUB.F4 F40 V25 25-MAR-76 15:03 PAGE 14
14M BLOCK 0
16700 RX=RX+1./DIS
MOVSI 02,201400
FDVR 02,DIS
FADRM 02,RX
16800 J8=-1
SETOM J8
16900 C FOR DOUBLE THICKNESS
17000 GO TO 301
JRST 301P
17100
17200 302 R8=R8*RST7
302P MOVE 02,RST7
FMPRM 02,R8
17300 R9=R9*RST7
MOVE 02,RST7
FMPRM 02,R9
17400 IF(R9.EQ.0)R9=R8
MOVE 02,R9
JUMPN 02,15M
MOVE 02,R8
MOVEM 02,R9
15M BLOCK 0
17500 C R9=0 MAKES SQUARE
17600 R3=R3Q-R8/2.
MOVE 02,R8
FSC 02,777777
FSBR 02,R3Q
MOVNM 02,R3
17700 RX=RX-R9/2.
MOVE 02,R9
FSC 02,777777
FSBRM 02,RX
MOVNS 00,RX
17710 RY=RX
MOVE 02,RX
MOVEM 02,RY
ITMSUB.F4 F40 V25 25-MAR-76 15:03 PAGE 15
17720 IF(R11.NE.0)RY=RY+R11*RST7
MOVE 02,R11
JUMPE 02,16M
MOVE 02,RST7
FMPR 02,R11
FADRM 02,RY
16M BLOCK 0
17730 C R11 IS OFFSET FOR PARALLELAGRAM
17800 J10=J10
17900 C DRAWS BOX, CENTER IS IN MIDDLE
18000 C 4,POS,STF,NT#,50,0,0,,SIZ1↑BY NT#S↑,SIZ2
18100 1302 CALL LINX(R3,RX,R3+R8,RY)
1302P MOVE 02,R3
FADR 02,R8
MOVEM 02,%TEMP.
JSA 16,LINX
ARG 02,R3
ARG 02,RX
ARG 02,%TEMP.
ARG 02,RY
18200 CALL LINES(R3+R8,RY+R9,2)
MOVE 02,R3
FADR 02,R8
MOVEM 02,%TEMP.
MOVE 03,RY
FADR 03,R9
MOVEM 03,%TEMP.+1
JSA 16,LINES
ARG 02,%TEMP.
ARG 02,%TEMP.+1
ARG 00,CONST.+5
18300 CALL LINES(R3,RX+R9,2)
MOVE 02,RX
FADR 02,R9
MOVEM 02,%TEMP.
JSA 16,LINES
ARG 02,R3
ARG 02,%TEMP.
ARG 00,CONST.+5
18400 CALL LINES(R3,RX,2)
JSA 16,LINES
ARG 02,R3
ITMSUB.F4 F40 V25 25-MAR-76 15:04 PAGE 16
ARG 02,RX
ARG 00,CONST.+5
18500 IF(J10.EQ.0)RETURN
MOVE 02,J10
JUMPN 02,17M
JRST 8M
17M BLOCK 0
18600 J10=J10-1
SOS J10
18700 RJ=1./DIS
MOVSI 02,201400
FDVR 02,DIS
MOVEM 02,RJ
18800 R3=R3-RJ
MOVN 02,RJ
FADRM 02,R3
18900 R8=R8+RJ+RJ
MOVE 02,RJ
FADR 02,RJ
FADRM 02,R8
19000 RX=RX-RJ
MOVN 02,RJ
FADRM 02,RX
19010 RY=RY-RJ
MOVN 02,RJ
FADRM 02,RY
19100 R9=R9+RJ+RJ
MOVE 02,RJ
FADR 02,RJ
FADRM 02,R9
19200 GO TO 1302
JRST 1302P
19300 C TO THICKEN BOXES.
19400
19500 1401 R4=2.0
1401P MOVSI 02,202400
MOVEM 02,R4
ITMSUB.F4 F40 V25 25-MAR-76 15:04 PAGE 17
19600 C FOR HEAVY BRACK.
19700 RA=RSTJ2*RBX
MOVE 02,RBX
FMPR 02,RSTJ2
MOVEM 02,RA
19800 RX=RX-RA
MOVN 02,RA
FADRM 02,RX
19900 C THE BOTTOM
20000 L=J4+J2-1
MOVNI 02,1
ADD 02,J4
ADD 02,J2
MOVEM 02,L
20100 R6=RTF
MOVE 02,RTF
MOVEM 02,R6
20200 IF(L.LE.4)GO TO 4401
MOVEI 02,4
CAML 02,L
JRST 4401P
20300 L=4
MOVEI 02,4
MOVEM 02,L
20400 R6=300.
MOVSI 02,211454
MOVEM 02,R6
20500 4401 RA=STFF(L)
4401P MOVE 03,L
MOVE 02,STFF +3(3)
MOVEM 02,RA
20600 C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
20700 RJY=RSTFAC(L)
MOVE 03,L
MOVE 02,RSTFAC+3(3)
MOVEM 02,RJY
20800 RY=RA+R6*RJY+RJY*56.+RJY*RBX
MOVE 02,R6
ITMSUB.F4 F40 V25 25-MAR-76 15:04 PAGE 18
FMPR 02,RJY
FADR 02,RA
MOVSI 03,206700
FMPR 03,RJY
FADR 02,3
MOVE 03,RBX
FMPR 03,RJY
FADR 02,3
MOVEM 02,RY
20900 C THE TOP
21000 R5=9.5
MOVSI 02,204460
MOVEM 02,R5
21100 GO TO 2401
JRST 2401P
21200
21300 C DASHES
21400 401 POS=POS-RST18
401P MOVN 02,RST18
FADRM 02,POS
21500 C********* 27/9/72 ******
21600 IF(J7.LE.0)GO TO 407
MOVE 02,J7
JUMPLE 02,407P
21700 IF(J7.EQ.4)GO TO 1401
MOVEI 02,4
CAMN 02,J7
JRST 1401P
21800 IF(J7.NE.3)GO TO 4001
MOVEI 02,3
CAME 02,J7
JRST 4001P
21900 C NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
22000 2401 JA=3
2401P MOVEI 02,3
MOVEM 02,JA
22100 IF(J10.EQ.0)J10=5
ITMSUB.F4 F40 V25 25-MAR-76 15:05 PAGE 19
MOVE 02,J10
JUMPN 02,18M
MOVEI 02,5
MOVEM 02,J10
18M BLOCK 0
22200 C DEFAULT VALUE FOR THICKNESS =5
22300 R4=R4-RBR
MOVN 02,RBR
FADRM 02,R4
22400 J9=0
SETZM J9
22500 J5=35
MOVEI 02,43
MOVEM 02,J5
22600 C THE NUM FOR THE LITTLE END ITEMS
22700 CC RY=R6-2.1*RSTJ2
22800 R6=3
MOVSI 02,202600
MOVEM 02,R6
22900 R7=0
SETZM R7
23000 C DOES LOWER ONE FIRST. ITEM IS IN 'CLEF3.DMD' ON DAT.LCS
23100 IF(J8.NE.2)CALL CLEFS
MOVEI 02,2
CAMN 02,J8
JRST 19M
JSA 16,CLEFS
19M BLOCK 0
23200 C P8=1=BOTTOM 1/2 BRACK. ONLY: =2=TOP 1/2 ONLY: 0=COMPLETE
23300 R4=R5-RBR
MOVN 02,RBR
FADR 02,R5
MOVEM 02,R4
23400 R6=3
MOVSI 02,202600
MOVEM 02,R6
ITMSUB.F4 F40 V25 25-MAR-76 15:05 PAGE 20
23500 R7=-3
MOVSI 02,575200
MOVEM 02,R7
23600 C TURNS IT UPSIDE DOWN.
23700 CC JA=3
23800 IF(J7.NE.4)GO TO 3401
MOVEI 02,4
CAME 02,J7
JRST 3401P
23900 POS=RA
MOVE 02,RA
MOVEM 02,POS
24000 R4=R4*RJY/RSTJ2
MOVE 02,R4
FMPR 02,RJY
FDVR 02,RSTJ2
MOVEM 02,R4
24100 C TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
24200 3401 IF(J8.NE.1)CALL CLEFS
3401P MOVEI 02,1
CAMN 02,J8
JRST 20M
JSA 16,CLEFS
20M BLOCK 0
24300 R3Q=R3Q-12.0*RSTJ2
MOVSI 02,204600
FMPR 02,RSTJ2
FSBRM 02,R3Q
MOVNS 00,R3Q
24400 IF(J7.NE.4)GO TO 407
MOVEI 02,4
CAME 02,J7
JRST 407P
24500 J7=0
SETZM J7
24600 GO TO 140
JRST 140P
24700
ITMSUB.F4 F40 V25 25-MAR-76 15:06 PAGE 21
24800 4002 J5=4
4002P MOVEI 02,4
MOVEM 02,J5
24900 C FOR CURVY BRACKET. P6 CAN CHANGE WIDTH.
25000 R8=0
SETZM R8
25100 J4=J4+J2-1
MOVNI 02,1
ADD 02,J4
ADD 02,J2
MOVEM 02,J4
25200 R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
MOVE 02,CONST.+7
MOVE 03,J4
FMPR 02,RSTFAC+3(3)
MOVE 04,STFF +3(3)
MOVE 03,J2
FSBR 04,STFF +3(3)
FMPR 04,CONST.+10
FADR 02,4
FDVR 02,RSTJ2
MOVEM 02,R7
25300 C .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
25400 C ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
25500 IF(R6.EQ.0)R6=1.+R7/20.
MOVE 02,R6
JUMPN 02,21M
MOVE 02,R7
FDVR 02,CONST.+11
FADRI 02,201400
MOVEM 02,R6
21M BLOCK 0
25600 JA=3
MOVEI 02,3
MOVEM 02,JA
25700 R4=2.3
MOVE 02,CONST.+6
MOVEM 02,R4
25800 C C BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*↑
ITMSUB.F4 F40 V25 25-MAR-76 15:07 PAGE 22
25900 CALL CLEFS
JSA 16,CLEFS
26000 RETURN
JRST 8M
26100
26200 4001 IF(J7.EQ.5)GO TO 4002
4001P MOVEI 02,5
CAMN 02,J7
JRST 4002P
26300 IF(R8.EQ.0)R8=.8
MOVE 02,R8
JUMPN 02,22M
MOVE 02,CONST.+12
MOVEM 02,R8
22M BLOCK 0
26400 C P8 CAN SET SIZE OF DASH
26402 RZ=5.96*RSTJ2
MOVE 02,CONST.+13
FMPR 02,RSTJ2
MOVEM 02,RZ
26405 RJ=R8*RZ
MOVE 02,RZ
FMPR 02,R8
MOVEM 02,RJ
26410 RZ=R9*RZ
MOVE 02,R9
FMPRM 02,RZ
26420 IF(R9.EQ.0)RZ=RJ
MOVE 02,R9
JUMPN 02,23M
MOVE 02,RJ
MOVEM 02,RZ
23M BLOCK 0
26430 C P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)
26440 R8=RJ
MOVE 02,RJ
MOVEM 02,R8
ITMSUB.F4 F40 V25 25-MAR-76 15:07 PAGE 23
26450 R9=RZ
MOVE 02,RZ
MOVEM 02,R9
26500 RD=RD+POS
MOVE 02,POS
FADRM 02,RD
26600 RJX=RD
MOVE 02,RD
MOVEM 02,RJX
26700 C =1 =DASHES, P6=P3=VERTICAL; P4=P5=HORIZ.; OTHERWISE SLOPE.
26800 J6=ROFF(RHORZ(R6))
JSA 16,RHORZ
ARG 02,R6
MOVEM 00,%TEMP.
JSA 16,ROFF
ARG 02,%TEMP.
MOVEM 00,%TEMP.+1
JSA 16,IFIX
ARG 00,%TEMP.+1
MOVEM 00,J6
26900 J3=J6-J3
MOVN 02,J6
ADDM 02,J3
MOVNS 00,J3
27000 J4=J5-J4
MOVN 02,J5
ADDM 02,J4
MOVNS 00,J4
27100 RJY=RD
MOVE 02,RD
MOVEM 02,RJY
27200 C SAVE FOR THICK LINES
27300 RA=J6
JSA 16,FLOAT
ARG 00,J6
MOVEM 00,RA
27400 C RA IS HORIZ. GOAL FOR DASHES
27500 402 RY=POS+R5*RST7
402P MOVE 02,RST7
ITMSUB.F4 F40 V25 25-MAR-76 15:07 PAGE 24
FMPR 02,R5
FADR 02,POS
MOVEM 02,RY
27600 IF(J4.EQ.0)GO TO 41
MOVE 02,J4
JUMPE 02,41P
27700 RH=RY-RD
MOVN 02,RD
FADR 02,RY
MOVEM 02,RH
27800 C TOTAL HEIGHT DIFF.
27900 RX=RA-R3
MOVN 02,R3
FADR 02,RA
MOVEM 02,RX
28000 C TOTAL LENGTH DIFF.
28100 RH=RH/RX
MOVE 02,RH
FDVR 02,RX
MOVEM 02,RH
28200 41 L=3
41P MOVEI 02,3
MOVEM 02,L
28300 K=2
MOVEI 02,2
MOVEM 02,K
28400 416 CALL LINES(R3Q,RD,L)
416P JSA 16,LINES
ARG 02,R3Q
ARG 02,RD
ARG 00,L
28405 IF(J3.EQ.0)GO TO 412
MOVE 02,J3
JUMPE 02,412P
28407 C JUMP FOR VERT. DASH
28410 IF(J3.GT.0)GO TO 422
MOVE 02,J3
JUMPG 02,422P
ITMSUB.F4 F40 V25 25-MAR-76 15:07 PAGE 25
28420 IF(R3Q.LE.RA)GO TO 413
MOVE 02,R3Q
CAMG 02,RA
JRST 413P
28425 C THIS IF P6 IS LESS THAN P3
28430 R3Q=R3Q-RJ
MOVN 02,RJ
FADRM 02,R3Q
28440 GO TO 423
JRST 423P
28500 422 IF(R3Q.GE.RA)GO TO 413
422P MOVE 02,R3Q
CAML 02,RA
JRST 413P
28600 C JUMP IF ALL DONE
28700 R3Q=R3Q+RJ
MOVE 02,RJ
FADRM 02,R3Q
28710 423 IF(J4.NE.0)RD=RJY+RH*(R3Q-R3)
423P MOVE 02,J4
JUMPE 02,24M
MOVE 02,R3Q
FSBR 02,R3
FMPR 02,RH
FADR 02,RJY
MOVEM 02,RD
24M BLOCK 0
28720 C FINDS HEIGHT OF RIGHT SIDE OF SLOPE
28800 414 CALL EXCH(L,K)
414P JSA 16,EXCH
ARG 00,L
ARG 00,K
28810 CALL EXCH(RJ,RZ)
JSA 16,EXCH
ARG 02,RJ
ARG 02,RZ
28820 C EXCH. SPACE AND DASH SIZE.
ITMSUB.F4 F40 V25 25-MAR-76 15:08 PAGE 26
28900 GO TO 416
JRST 416P
28950 412 IF(J4.GT.0)GO TO 424
412P MOVE 02,J4
JUMPG 02,424P
28960 IF(RD.LE.RY)GO TO 413
MOVE 02,RD
CAMG 02,RY
JRST 413P
28970 RD=RD-RJ
MOVN 02,RJ
FADRM 02,RD
28980 C THIS IF P5 IS LESS THAN P4.
28990 GO TO 414
JRST 414P
29000 424 IF(RD.GE.RY)GO TO 413
424P MOVE 02,RD
CAML 02,RY
JRST 413P
29100 C JUMP IF DONE
29200 RD=RD+RJ
MOVE 02,RJ
FADRM 02,RD
29300 GO TO 414
JRST 414P
29400 413 IF(J10.GT.0)GO TO 420
413P MOVE 02,J10
JUMPG 02,420P
29410 IF(J11.EQ.0)RETURN
MOVE 02,J11
JUMPN 02,25M
JRST 8M
25M BLOCK 0
29415 IF(J3)RJ=-RJ
MOVE 02,J3
JUMPGE 02,26M
MOVNS 00,RJ
26M BLOCK 0
ITMSUB.F4 F40 V25 25-MAR-76 15:09 PAGE 27
29420 IF(L.EQ.3)R3Q=R3Q-RJ
MOVEI 02,3
CAME 02,L
JRST 27M
MOVN 02,RJ
FADRM 02,R3Q
27M BLOCK 0
29430 RX=R8
MOVE 02,R8
MOVEM 02,RX
29440 IF(J11)RX=-RX
MOVE 02,J11
JUMPGE 02,28M
MOVNS 00,RX
28M BLOCK 0
29450 CALL LINX(R3Q,RD,R3Q,RD+RX)
MOVE 02,RD
FADR 02,RX
MOVEM 02,%TEMP.
JSA 16,LINX
ARG 02,R3Q
ARG 02,RD
ARG 02,R3Q
ARG 02,%TEMP.
29460 C PUTS BRACK END ON DASHED LINE. (P11=1 OR -1)
29470 RETURN
JRST 8M
29480
29500 C NEXT FOR THICK DASHES
29600 420 J10=J10-1
420P SOS J10
29650 RJ=1./DIS
MOVSI 02,201400
FDVR 02,DIS
MOVEM 02,RJ
29700 IF(J3.EQ.0)GO TO 415
MOVE 02,J3
JUMPE 02,415P
ITMSUB.F4 F40 V25 25-MAR-76 15:09 PAGE 28
29800 R3Q=R3
MOVE 02,R3
MOVEM 02,R3Q
29900 RJY=RJY+RJ
MOVE 02,RJ
FADRM 02,RJY
29950 RD=RJY
MOVE 02,RJY
MOVEM 02,RD
30000 GO TO 417
JRST 417P
30100 415 R3Q=R3Q+RJ
415P MOVE 02,RJ
FADRM 02,R3Q
30200 RD=RJX
MOVE 02,RJX
MOVEM 02,RD
30210 417 RJ=R8
417P MOVE 02,R8
MOVEM 02,RJ
30220 RZ=R9
MOVE 02,R9
MOVEM 02,RZ
30230 C FOR THICK DASHES.
30300 GO TO 41
JRST 41P
30400
30500
30600 407 RX=RD+POS
407P MOVE 02,RD
FADR 02,POS
MOVEM 02,RX
30700 RY=R5*RST7+POS
MOVE 02,RST7
FMPR 02,R5
FADR 02,POS
MOVEM 02,RY
ITMSUB.F4 F40 V25 25-MAR-76 15:09 PAGE 29
30800 IF(J7.EQ.3)GO TO 140
MOVEI 02,3
CAMN 02,J7
JRST 140P
30900 CALL NOZERO(R9)
JSA 16,NOZERO
ARG 02,R9
31000 IF(J7.EQ.-1)GO TO 408
MOVNI 02,1
CAMN 02,J7
JRST 408P
31100 C FOR 'TR' J7=-2, 'ARPEGG' J7=-1, STRAIGHT LINES J7=0
31200 CC WHY THE IFIX???? RJX=IFIX(RHORZ(R6))
31300 RJX=IFIX(ROFF(RHORZ(R6)))
JSA 16,RHORZ
ARG 02,R6
MOVEM 00,%TEMP.
JSA 16,ROFF
ARG 02,%TEMP.
MOVEM 00,%TEMP.+1
JSA 16,IFIX
ARG 02,%TEMP.+1
MOVEM 00,%TEMP.+2
JSA 16,FLOAT
ARG 00,%TEMP.+2
MOVEM 00,RJX
31400 C ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
31500 IF(J7.EQ.0)GO TO 42
MOVE 02,J7
JUMPE 02,42P
31600 RY=R9*RST7+RX
MOVE 02,RST7
FMPR 02,R9
FADR 02,RX
MOVEM 02,RY
31700 CALL NOZERO(R8)
JSA 16,NOZERO
ARG 02,R8
31800 4041 RZ=RX
ITMSUB.F4 F40 V25 25-MAR-76 15:09 PAGE 30
4041P MOVE 02,RX
MOVEM 02,RZ
31900 RH=RY
MOVE 02,RY
MOVEM 02,RH
32000 C SAVE FOR THICK WIGGLES
32100 CALL LINES(R3Q,RX,3)
JSA 16,LINES
ARG 02,R3Q
ARG 02,RX
ARG 00,CONST.+3
32200 C DRAWS STRAIGHT LINES. ETC.
32300 R9=R3Q
MOVE 02,R3Q
MOVEM 02,R9
32400 RJ=RY
MOVE 02,RY
MOVEM 02,RJ
32500 RW=3.*RSTJ2*R8
MOVSI 02,202600
FMPR 02,RSTJ2
FMPR 02,R8
MOVEM 02,RW
32600 RA=RW*2.5
MOVSI 02,202500
FMPR 02,RW
MOVEM 02,RA
32700 C P8=HORZ. WIGGLE SIZE; P9=VERT. SIZE
32800 404 R9=R9+RA
404P MOVE 02,RA
FADRM 02,R9
32900 CALL LINES(R9,RJ,2)
JSA 16,LINES
ARG 02,R9
ARG 02,RJ
ARG 00,CONST.+5
33000 R9=R9+RW
MOVE 02,RW
ITMSUB.F4 F40 V25 25-MAR-76 15:10 PAGE 31
FADRM 02,R9
33100 CALL LINES(R9,RJ,2)
JSA 16,LINES
ARG 02,R9
ARG 02,RJ
ARG 00,CONST.+5
33200 405 CALL EXCH(RX,RJ)
405P JSA 16,EXCH
ARG 02,RX
ARG 02,RJ
33300 IF(R9.LT.RJX)GO TO 404
MOVE 02,RJX
CAMLE 02,R9
JRST 404P
33400 IF(J10.LE.0)RETURN
MOVE 02,J10
JUMPG 02,29M
JRST 8M
29M BLOCK 0
33450 RY=1./DIS
MOVSI 02,201400
FDVR 02,DIS
MOVEM 02,RY
33500 RX=RZ+RY
MOVE 02,RZ
FADR 02,RY
MOVEM 02,RX
33600 RY=RH+RY
MOVE 02,RH
FADRM 02,RY
33700 J10=J10-1
SOS J10
33800 GO TO 4041
JRST 4041P
33900 C P10= + NUM OF THICKNESSES TO WIGGLE
34000
34100 408 IF(RX.GT.RY)CALL EXCH(RX,RY)
408P MOVE 02,RX
ITMSUB.F4 F40 V25 25-MAR-76 15:10 PAGE 32
CAMG 02,RY
JRST 30M
JSA 16,EXCH
ARG 02,RX
ARG 02,RY
30M BLOCK 0
34200 RZ=R9*RSTJ2*5.96
MOVE 02,RSTJ2
FMPR 02,R9
FMPR 02,CONST.+13
MOVEM 02,RZ
34300 C USE P9 TO SET WIGGLE WIDTH. P8 TO SET HGT.
34400 CALL NOZERO(R8)
JSA 16,NOZERO
ARG 02,R8
34500 RD=R8*RST7*.5
MOVE 02,RST7
FMPR 02,R8
FSC 02,777777
MOVEM 02,RD
34600 RJ=RD
MOVE 02,RD
MOVEM 02,RJ
34700 IF(RD.LT.1.)RD=1.
MOVSI 02,201400
CAMG 02,RD
JRST 31M
MOVSI 02,201400
MOVEM 02,RD
31M BLOCK 0
34800 421 R9=RX
421P MOVE 02,RX
MOVEM 02,R9
34900 RW=R3Q
MOVE 02,R3Q
MOVEM 02,RW
35000 RA=RZ+R3Q
MOVE 02,R3Q
FADR 02,RZ
MOVEM 02,RA
ITMSUB.F4 F40 V25 25-MAR-76 15:10 PAGE 33
35100 CALL LINES(RW,R9,3)
JSA 16,LINES
ARG 02,RW
ARG 02,R9
ARG 00,CONST.+3
35200 410 R9=R9+RJ
410P MOVE 02,RJ
FADRM 02,R9
35300 CALL LINES(RA,R9,2)
JSA 16,LINES
ARG 02,RA
ARG 02,R9
ARG 00,CONST.+5
35400 R9=R9+RD
MOVE 02,RD
FADRM 02,R9
35500 CALL LINES(RA,R9,2)
JSA 16,LINES
ARG 02,RA
ARG 02,R9
ARG 00,CONST.+5
35600 CALL EXCH(RA,RW)
JSA 16,EXCH
ARG 02,RA
ARG 02,RW
35700 IF(R9.LT.RY)GO TO 410
MOVE 02,RY
CAMLE 02,R9
JRST 410P
35800 IF(J10.LE.0)RETURN
MOVE 02,J10
JUMPG 02,32M
JRST 8M
32M BLOCK 0
35900 R3Q=R3Q+1./DIS
MOVSI 02,201400
FDVR 02,DIS
FADRM 02,R3Q
36000 J10=J10-1
SOS J10
ITMSUB.F4 F40 V25 25-MAR-76 15:10 PAGE 34
36100 GO TO 421
JRST 421P
36200 C VERTICAL WIGGLE P10=+ NUM OF THICKNESSES.
36300 END
JRST 8M
ITMSU% ARG 00,0
MOVEM 15,TEMP. +1
MOVEM 16,TEMP. +2
JRST 1M
8M MOVE 15,TEMP. +1
MOVE 16,TEMP. +2
JRA 16,0(16)
CONSTANTS
0 000000000144 1 000000000001 2 205420000000 3 000000000003 4 201400000000
5 000000000002 6 202446314631 7 177501100557 10 171557000643 11 205500000000
12 200631463146 13 203575341217
COMMON
RSTFAC /STF /+0 RSTJ2 /STF /+10 MINI /MIN /+0 RMINI /MIN /+1 R2 /.COMM./+0
JA /.COMM./+1 CENTR /.COMM./+2 J2 /.COMM./+3 RJQ /.COMM./+4 JQ /.COMM./+30
RE /.COMM./+50 RF /.COMM./+51 RG /.COMM./+52 RH /.COMM./+53 RA /BM /+0
RC /BM /+1 RJY /BM /+2 STFF /POSI /+0 JJ2 /POSI /+10 POS /POSI /+11
PLT /PLTR /+0 RHT /PLTR /+1 DIS /PLTR /+2 QQ /ALF /+0 RST7 /ALF /+3
RST18 /ALF /+4 R3Q /ALF /+5 JY /ALF /+6 RD /ALF /+7 RX /ALF /+10
RW /ALF /+11 RJX /ALF /+12 RJ /ALF /+13 L /ALF /+14 K /ALF /+15
RJA /ALF /+16 YY /ALF /+17 DISX /ALF /+20 HGT /ALF /+21 RZ /ALF /+22
INP /ALF /+23 RACNT /DAT /+0 RDOT /DAT /+101 XAC /DAT /+122 RNOTE /DAT /+131
RACCI /DAT /+157 NACCI /DAT /+205 J3 /.COMM./+30 J4 /.COMM./+31 J5 /.COMM./+32
R5 /.COMM./+6 R11 /.COMM./+14 R6 /.COMM./+7 J7 /.COMM./+34 J8 /.COMM./+35
J9 /.COMM./+36 J10 /.COMM./+37 J11 /.COMM./+40 J6 /.COMM./+33 R9 /.COMM./+12
R8 /.COMM./+11 R3 /.COMM./+4 R7 /.COMM./+10 R4 /.COMM./+5 R10 /.COMM./+13
RX3 /.COMM./+27
SUBPROGRAMS
FLOAT IFIX MOD CENTX RDRAW LINES ABS RHORZ LINX CLEFS ROFF EXCH NOZERO
SCALARS
ITMSUB 1514 R14 1515 RTF 1516 RHGT 1517 R2HGT 1520
RBM 1521 RDBR 1522 RBR 1523 RBX 1524 RST7 3
RSTJ2 10 RST18 4 R3Q 5 R3 4 RD 7
R4 5 RA 0 RX 10 POS 11 J10 37
ITMSUB.F4 F40 V25 25-MAR-76 15:11 PAGE 35
DIS 2 J5 32 R6 7 J7 34 JA 1
DBR 1525 J4 31 L 14 RJ 13 RZ 22
RJA 16 JY 6 K 15 J2 3 CENTR 2
RY 1526 PLT 0 RJX 12 RW 11 R7 10
R8 11 J8 35 R9 12 R11 14 RJY 2
R5 6 J9 36 J6 33 J3 30 RH 53
J11 40 MINI 0 RMINI 1 R2 0 RE 50
RF 51 RG 52 RC 1 JJ2 10 RHT 1
YY 17 DISX 20 HGT 21 R10 13 RX3 27
ARRAYS
RSTFAC 0 RJQ 4 JQ 30 STFF 0 QQ 0
INP 23 RACNT 0 RDOT 101 XAC 122 RNOTE 131
RACCI 157 NACCI 205